home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / UTILSTIC / SYSID47.LZH / PAGE_05.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-08  |  4KB  |  168 lines
  1. procedure page_05;
  2.   const
  3.     vidmodes: array [$00..$13] of string[36] = (
  4.                 '(40 x 25 b/w text)',
  5.                 '(40 x 25 color text)',
  6.                 '(80 x 25 b/w text)',
  7.                 '(80 x 25 color text)',
  8.                 '(320 x 200 4 colors)',
  9.                 '(320 x 200 4 colors, no color burst)',
  10.                 '(640 x 200 2 colors)',
  11.                 '(MDA text)',
  12.                 '(160 x 200 16 colors)',
  13.                 '(320 x 200 16 colors)',
  14.                 '(640 x 200 4 colors)',
  15.                 '(reserved)',
  16.                 '(reserved)',
  17.                 '(320 x 200 16 colors)',
  18.                 '(640 x 200 16 colors)',
  19.                 '(640 x 350 monochrome)',
  20.                 '(640 x 350 16 colors)',
  21.                 '(640 x 480 2 colors)',
  22.                 '(640 x 480 16 colors)',
  23.                 '(320 x 200 256 colors)');
  24.  
  25.  
  26.   var
  27.     i : byte;
  28.     xbyte : byte;
  29.     xint1 : integer;
  30.     xint2 : integer;
  31.     xword : word;
  32.     mono2: boolean;
  33.  
  34. procedure showdisp(a : string; b : byte);
  35.   const
  36.     dispmons: array [0..$0C] of string[25] = (
  37.                '(none)',
  38.                'MDA + 5151',
  39.                'CGA + 5153/5154',
  40.                '(reserved)',
  41.                'EGA + 5153/5154',
  42.                'EGA 5151',
  43.                'PGA + 5175',
  44.                'VGA + analog monochrome',
  45.                'VGA + analog color',
  46.                '(reserved)',
  47.                'MCGA + digital color',
  48.                'MCGA + digital monochrome',
  49.                'MCGA + analog color');
  50.  
  51. begin
  52.   caption2(a);
  53.   case b of
  54.     $00..$0C: Writeln(dispmons[b]);
  55.     $0D..$FE: Writeln('(reserved)');
  56.     $FF: dontknow
  57.   end;
  58. end; {showdisp}
  59.  
  60. procedure showcolor(a : byte);
  61.   const
  62.     colors: array[black..white] of string[13] = (
  63.              'black', 'blue', 'green', 'cyan', 'red', 'magenta', 'brown',
  64.              'light gray', 'dark gray', 'light blue', 'light green',
  65.              'light cyan', 'light red', 'light magenta', 'yellow', 'white');
  66.  
  67.   begin
  68.   if a <= white then
  69.     Write(colors[a])
  70.   else
  71.     unknown('color', a, 2)
  72.   end; {showcolor}
  73.  
  74.   begin (* procedure page_05 *)
  75.   with regs do
  76.     begin
  77.     AX:=$1A00;
  78.     intr($10, regs);
  79.     if AL = $1A then
  80.       begin
  81.       showdisp('Active video subsystem  ', BL);
  82.       showdisp('Inactive video subsystem', BH)
  83.       end
  84.     end;
  85.   caption2('Initial video mode');
  86.   case equip and $0030 of
  87.     $0000 : writeln('No display');
  88.     $0010 : writeln('40 x 25 color');
  89.     $0020 : writeln('80 x 25 color');
  90.     $0030 : writeln('80 x 25 monochrome')
  91.   end;
  92.   caption2('Current video mode');
  93.   xbyte:=lo(lastmode);
  94.   Write(xbyte, ' ');
  95.   if xbyte <= $13 then
  96.     Writeln(vidmodes[xbyte])
  97.   else
  98.     unknown('video mode', xbyte, 2);
  99.   caption2('Current display page');
  100.   writeln(vidpg);
  101.   caption2('Graphics modes');
  102.   getmoderange(graphdriver, xint1, xint2);
  103.   if graphresult = grok then
  104.     writeln(xint2 + 1 - xint1)
  105.   else
  106.     writeln(0);
  107.   caption2('Video buffer (offset)');
  108.   writeln(hex(memw[BIOSdseg : $004E], 4));
  109.   caption2('Video buffer size (bytes)');
  110.   writeln(memw[BIOSdseg : $004C]);
  111.   caption2('Active display port');
  112.   xword:=memw[BIOSdseg : $0063];
  113.   write('$', hex(xword, 3), ' ');
  114.   if xword = $03B4 then
  115.     writeln('(monochrome)')
  116.   else
  117.      if xword = $03D4 then
  118.        writeln('(color)')
  119.      else
  120.        dontknow;
  121.   caption2('CRT mode register');
  122.   writeln('$', hex(mem[BIOSdseg : $0065], 2));
  123.   caption2('Current palette');
  124.   writeln('$', hex(mem[BIOSdseg : $0066], 2));
  125.   caption2('Colors');
  126.   caption1('·');
  127.   mono2:=mono;
  128.   mono:=false;
  129.   for i:=black to white do
  130.     begin
  131.     textcolor(i);
  132.     write('█')
  133.     end;
  134.   mono:=mono2;
  135.   caption1('·');
  136.   writeln;
  137.   caption2('Current colors');
  138.   if (attrsave and $80) = $80 then
  139.     write('blinking ');
  140.   showcolor(attrsave and $0F);
  141.   write(' on ');
  142.   showcolor(attrsave and $70 shr 4);
  143.   writeln;
  144.   caption2('Text rows');
  145.   writeln(tlength);
  146.   caption2('Text columns');
  147.   writeln(twidth);
  148.   if graphdriver in [EGA, MCGA, VGA] then
  149.     begin
  150.     caption2('Scan lines/character');
  151.     with regs do
  152.       begin
  153.       AX:=$1130;
  154.       BH:=$00;
  155.       intr($10, regs);
  156.       writeln(CX)
  157.       end
  158.     end;
  159.   caption2('Cursor scan lines');
  160.   with regs do
  161.     begin
  162.     AH:=$03;
  163.     BH:=vidpg;
  164.     intr($10, regs);
  165.     writeln(CH, '-', CL)
  166.     end
  167.   end;
  168.